home *** CD-ROM | disk | FTP | other *** search
/ PC go! 2008 April / PCgo 2008-04 (DVD).iso / interface / contents / demoversionen_3846 / 13664 / files / Data1.cab / converter.cls < prev    next >
Encoding:
Visual Basic class definition  |  2005-03-31  |  6.2 KB  |  182 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "Converter"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = True
  14. Option Explicit
  15. 'Number of tools in this server
  16. Const NUM_TOOLS = 1
  17. 'Toggle this to test loading buttons from .Bmp/.Res
  18. Const boolLoadFromBmp As Boolean = False
  19. 'Return a description string for this package of tools
  20. Public Property Get Description() As String
  21.     Description = LoadResString(101) '"TurboCAD File Converter"
  22. End Property
  23.  
  24. 'Called to perform tool function
  25. Public Function Run(ByVal Tool As Object) As Boolean
  26. '    On Error Resume Next
  27. On Error GoTo E
  28. Err.Clear
  29.     Set ObjApp = Tool.Application
  30.     If ObjApp Is Nothing Then
  31.         MsgBox LoadResString(102) & Err.Description & LoadResString(103)
  32.         Exit Function
  33.     End If
  34.     Set Drs = ObjApp.Drawings
  35.     If Drs Is Nothing Then
  36.         MsgBox LoadResString(104) & Err.Description & LoadResString(103)
  37.         Exit Function
  38.     End If
  39.     
  40. ' store current setting for ask Summary Info dialog on drawing save
  41.     isSummInfo = ObjApp.Properties("PromptForSummaryInfo").Value
  42. ' disable ask for Summary Info dialog on drawing save
  43.     ObjApp.Properties("PromptForSummaryInfo") = False
  44.     frmConverter.Show vbModal
  45. ' restore original setting
  46.     ObjApp.Properties("PromptForSummaryInfo") = CLng(isSummInfo)
  47.  
  48.     Set Drs = Nothing
  49.     Set ObjApp = Nothing
  50.     
  51.     Run = True
  52.     Exit Function
  53. E:
  54.     MsgBox "Run failed " & Err.Description
  55.     Set Drs = Nothing
  56.     Set ObjApp = Nothing
  57.  
  58. End Function
  59.  
  60. 'Fill arrays with information about tools in the package
  61. 'Return the number of tools in the package
  62. Public Function GetToolInfo(CommandNames As Variant, MenuCaptions As Variant, StatusPrompts As Variant, _
  63.     ToolTips As Variant, Enabled As Variant, WantsUpdates As Variant) As Long
  64.     
  65.     Dim sICmd As String
  66.     
  67.     'ReDim CommandNames(NUM_TOOLS, 5)
  68.     ReDim CommandNames(NUM_TOOLS) ', 5)
  69.     ReDim MenuCaptions(NUM_TOOLS, 2)
  70.     ReDim StatusPrompts(NUM_TOOLS)
  71.     ReDim ToolTips(NUM_TOOLS)
  72.     ReDim Enabled(NUM_TOOLS)
  73.     ReDim WantsUpdates(NUM_TOOLS)
  74.     
  75.     sICmd = LoadResString(105) '"S&DK|&Utils|File &Converter"
  76.     CommandNames(0) = sICmd + "#CMD_SDKFILECONVERTER"
  77.     
  78.     MenuCaptions(0, 0) = LoadResString(106) '"&File Converter"
  79.     MenuCaptions(0, 1) = LoadResString(107) '"SDK"
  80.     
  81.     StatusPrompts(0) = LoadResString(108) '"Launch the File Converter"
  82.     ToolTips(0) = LoadResString(109) '"File Converter"
  83.     Enabled(0) = True
  84.     WantsUpdates(0) = False
  85.     GetToolInfo = NUM_TOOLS
  86. End Function
  87.  
  88.  
  89. 'Copy a windows bitmap of the requested size to the clipboard
  90. 'Bitmaps returned should contain NUM_TOOLS images
  91. 'Size of entire bitmap:
  92. 'Normal:  (NUM_TOOLS*16) wide x 15 high
  93. 'Large:   (NUM_TOOLS*24) wide x 23 high
  94. 'Mono bitmap should be 1-bit (black or white)
  95. Public Function CopyBitmap(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean) As Boolean
  96.     On Error GoTo BitmapError
  97.     Dim TheImage As New StdPicture
  98.     If GetButtonPicture(LargeImage, MonoImage, TheImage) Then
  99.         'Put the image on the Windows clipboard
  100.         Clipboard.SetData TheImage, vbCFDIB
  101.         CopyBitmap = True
  102.         Exit Function
  103.     End If
  104. BitmapError:
  105.     CopyBitmap = False
  106. End Function
  107.  
  108. 'Return a Picture object for the requested size
  109. 'Apparently, returning references to StdPicture objects doesn't work for .EXE servers
  110. 'Bitmaps returned should contain NUM_TOOLS images
  111. 'Size of entire image:
  112. 'Normal:  (NUM_TOOLS*16) wide x 15 high
  113. 'Large:   (NUM_TOOLS*24) wide x 23 high
  114. 'Mono image should be 1-bit (black or white)
  115. Public Function GetPicture(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean) As Object
  116.     On Error GoTo PictureError
  117.     Dim TheImage As New StdPicture
  118.     If GetButtonPicture(LargeImage, MonoImage, TheImage) Then
  119.         Set GetPicture = TheImage
  120.         Exit Function
  121.     End If
  122.  
  123. PictureError:
  124.     Set GetPicture = Nothing
  125. End Function
  126.  
  127. 'Returns true if tool is correctly initialized
  128. Public Function Initialize(ByVal Tool As Object) As Boolean
  129.     Initialize = True
  130. End Function
  131.  
  132. 'Returns true if tool is correctly initialized
  133. Public Function UpdateToolStatus(ByVal Tool As Object, Enabled As Boolean, Checked As Boolean) As Boolean
  134.     Enabled = True 'Could do a test here to determine whether to disable the button/menu item
  135.     Checked = False  'Could do a test here to determine whether to check the button/menu item
  136.     UpdateToolStatus = True
  137. End Function
  138.  
  139. 'Implementation specific stuff
  140. 'Private function to return the bitmap from .Res file or .Bmp file
  141. Private Function GetButtonPicture(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean, TheImage As StdPicture) As Boolean
  142.     On Error GoTo LoadError
  143.  
  144.     'There are two ways to load images:  from .Bmp file(s) or from .RES resource.
  145.     'In this demo, we control the loading by a private variable.
  146.     
  147.     'Note that if you are loading from .Bmp, or if you are running this tool as a
  148.     '.VBP for debugging, you must place the .Res or .Bmp files in the Draggers subdirectory
  149.     'of the directory in which TCW40.EXE (or IMSIGX40.DLL) is located.
  150.  
  151.     If boolLoadFromBmp Then
  152.         'Load from .Bmp file
  153.         Dim strFileName As String 'File name of .Bmp file to load
  154.  
  155.         If LargeImage Then
  156.             strFileName = App.Path & "\bmp2.bmp"
  157.         Else
  158.             strFileName = App.Path & "\bmp1.bmp"
  159.         End If
  160.         Set TheImage = LoadPicture(strFileName)
  161.     Else
  162.         'Load from .Res file
  163.         Dim idBitmap%  'BITMAP resource id in .Res file
  164.  
  165.         If LargeImage Then
  166.             idBitmap% = 102
  167.         Else
  168.             idBitmap% = 101
  169.         End If
  170.         Set TheImage = LoadResPicture(idBitmap%, vbResBitmap)
  171.     End If
  172.  
  173.     'Return the image
  174.     GetButtonPicture = True
  175.     Exit Function
  176.  
  177. LoadError:
  178. '        MsgBox "Error loading bitmap: " & Err.Description
  179.         MsgBox LoadResString(113) & Err.Description
  180.     GetButtonPicture = False
  181. End Function
  182.